home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 February: Tool Chest / Apple Developer CD Series Tool Chest February 1996 (Apple Computer)(1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Marlais / MacMarlais 0.5.9d46 / Examples / Random.dyl < prev    next >
Encoding:
Text File  |  1995-02-09  |  16.8 KB  |  532 lines  |  [TEXT/Mrls]

  1. module:        dylan-user
  2. author:        dpierce@cs.cmu.edu
  3. synopsis:        This file implements random numbers for the Gwydion
  4.             implementation of Dylan. (Hacked by beard@cs.ucdavis for Marlais.)
  5. copyright:    Copyright (C) 1994, Carnegie Mellon University.
  6.             All rights reserved.
  7. rcs-header:    $Header: distributions.dylan,v 1.2 94/06/28 23:57:55 wlott Exp$
  8.  
  9. //======================================================================
  10. //
  11. // Copyright (c) 1994  Carnegie Mellon University
  12. // All rights reserved.
  13. // 
  14. // Use and copying of this software and preparation of derivative
  15. // works based on this software are permitted, including commercial
  16. // use, provided that the following conditions are observed:
  17. // 
  18. // 1. This copyright notice must be retained in full on any copies
  19. //    and on appropriate parts of any derivative works.
  20. // 2. Documentation (paper or online) accompanying any system that
  21. //    incorporates this software, or any part of it, must acknowledge
  22. //    the contribution of the Gwydion Project at Carnegie Mellon
  23. //    University.
  24. // 
  25. // This software is made available "as is".  Neither the authors nor
  26. // Carnegie Mellon University make any warranty about the software,
  27. // its performance, or its conformity to any specification.
  28. // 
  29. // Bug reports, questions, comments, and suggestions should be sent by
  30. // E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  31. //
  32. //======================================================================
  33.  
  34. /* Random Number Distributions
  35.  
  36.    This file contains class definitions and functions for using random
  37.    number distributions.  The basis of these methods is the generation
  38.    of a uniform distribution on the interval [0, 1) using the Linear
  39.    Congruential Method.
  40.  
  41.    Other probability distributions are generated using transformations
  42.    of the basic unit uniform distribution.  Some that are defined here
  43.    are other uniform distribution, normal, and exponential
  44.    distributions.
  45.  
  46.    This implementation defines an abstract class
  47.    <random-distribution>.  All subclasses of <random-distribution>
  48.    must define a method for the generic function RANDOM.  This
  49.    function returns a random number in the distribution.
  50.  
  51. */
  52.  
  53. /*
  54. define module Random
  55.    use dylan;
  56.    export
  57.       <random-distribution>, random,
  58.  
  59.       <uniform-distribution>,
  60.       <unit-uniform-distribution>,
  61.       <real-uniform-distribution>,
  62.       <integer-uniform-distribution>,
  63.       <exponential-distribution>,
  64.       <normal-distribution>,
  65.  
  66.       *dylan-random-seed*, *dylan-random-distribution*,
  67.       random-uniform, seed-random!,
  68.  
  69.       chi-square;
  70. end module Random;
  71. */
  72.  
  73. // <random-distribution> -- public
  74. //
  75. // Abstract superclass of random distributions.  Each subclass must
  76. // define a method for RANDOM, which returns a random number from the
  77. // distribution.
  78. //
  79. define abstract class <random-distribution> (<object>) end class;
  80.  
  81.  
  82. // random -- public
  83. //
  84. // Methods on this function return a random number generated from
  85. // whichever distribution is being used.
  86. //
  87. define generic random (random-distribution :: <random-distribution>)
  88.    => random :: <real>;
  89.  
  90.  
  91. /* Unit Uniform Distribution
  92.  
  93.               Linear Congruential Method
  94.  
  95.    The basic algorithm used to generate random numbers is called the
  96.    Linear Congruential Method (see, for example, Sedgewick,
  97.    Algorithms, chapter 35).  The Linear Congruential method uses a
  98.    recurrence
  99.  
  100.                z  = a z    + 1 (mod m)
  101.                         k      k-1
  102.  
  103.    to generate pseudo-random sequences of integers uniformly
  104.    distributed between 0 and m - 1.  The first z is called the seed of
  105.    the sequence.
  106.  
  107.    There are some basic rules for the values of the constants (see
  108.    Sedgewick).  The value of m should be large.  Since Mindy has 30
  109.    bit integers, we take m to be
  110.  
  111.                                      28
  112.                 m = 2
  113.  
  114.                                   = 268 435 456
  115.  
  116.    The value of a should not be as large, perhaps one digit shorter
  117.    than m, and it should end with the three digits x21 where x is
  118.    even.  So we take a (arbitrarily) to be
  119.  
  120.                     a = 29 413 621
  121.  
  122.    Now, we cannot calculate each z directly because the calculation
  123.    would overflow the integer size.  Instead we multiply (a z) in
  124.    parts.  We take k to be the square root of m.  Then if
  125.  
  126.            p = p1 k + p0 and q = q1 k + q0
  127.  
  128.    then
  129.  
  130.          p q = (p1 q1) m + (p1 q0 + p0 q1) k + p0 q0
  131.  
  132.    and
  133.  
  134.       p q (mod m) = ((p1 q0 + p0 q1 (mod k)) k + p0 q0) (mod m)
  135.  
  136.    Using this method we can calculate (a z) (mod m) without overflow.
  137.  
  138.    Now a uniform distribution on [0, 1) can be found by dividing the
  139.    random variable z by m.
  140.  
  141. */
  142.  
  143. // <uniform-distribution> -- public
  144. // 
  145. // Abstract superclass of uniform distributions.  Uniform
  146. // distributions are distributions such that every element of the
  147. // range should appear with equal frequency.
  148. //
  149. define abstract class <uniform-distribution> (<random-distribution>) end class;
  150.  
  151. // <unit-uniform-distribution> -- public
  152. //
  153. // This concrete class provides the implementation of the basic
  154. // uniform random number distribution on [0, 1).  It uses the linear
  155. // congruential method.
  156. //
  157. define class <unit-uniform-distribution> (<uniform-distribution>)
  158.    slot random-seed :: <integer>,
  159.       init-function: method () *dylan-random-seed* end method,
  160.       init-keyword: seed:;
  161. end class;
  162.  
  163.  
  164. // random -- public
  165. // 
  166. // Returns a random number from the unit uniform distribution.  Uses
  167. // the linear congruential method described above.  An integer between
  168. // 0 and m - 1 is generated.  This is put into the RANDOM-SEED slot of
  169. // the distribution and then divided by m to produce a real between 0
  170. // and 1.
  171. //
  172.  
  173. define constant $a$ = 29413621;
  174. define constant $m$ = ash (1, 28);
  175. define constant $k$ = ash (1, 14);
  176. define constant a1 = floor/ ($a$, $k$);
  177. define constant a0 = modulo ($a$, $k$);
  178.  
  179. define method random (dist :: <unit-uniform-distribution>)
  180.       => random :: <double-float>;
  181.    let z = dist.random-seed;
  182.    let z1 = floor/ (z, $k$);
  183.    let z0 = modulo (z, $k$);
  184.    let r = modulo (modulo (a1 * z0 + a0 * z1, $k$) * $k$ + a0 * z0 , $m$);
  185.    dist.random-seed := r;
  186.    as (<double-float>, r) / as (<double-float>, $m$)
  187. end method;
  188.  
  189.  
  190. /* Other Uniform Distributions
  191.  
  192.    Most other random distribution generators rely on the unit uniform
  193.    generator.
  194.  
  195.    A uniform distribution of reals over an arbitrary interval [a, b)
  196.    can be obtained from the unit uniform random variable U by
  197.  
  198.               R = (b - a) U + a
  199.  
  200.    Similarly, a uniform distribution of integers over an arbitrary
  201.    interval [a, b] can be obtained from the unit uniform random
  202.    variable U by
  203.  
  204.               I = round ((b - a) U + a)
  205.  
  206. */
  207.  
  208. // <real-uniform-distribution> -- public
  209. //
  210. // The concrete class for real uniform distributions.  Slots for the
  211. // beginning and ending point of the distribution interval.
  212. //
  213. define class <real-uniform-distribution> (<uniform-distribution>)
  214.    slot unit-uniform :: <unit-uniform-distribution>;
  215.    slot random-from :: <real>,
  216.       required-init-keyword: from:;
  217.    slot random-to :: <real>,
  218.       required-init-keyword: to:;
  219. end class;
  220.  
  221.  
  222. // initialize -- interface
  223. //
  224. // The unit uniform distribution used in the uniform has to be set up.
  225. //
  226. define method initialize (dist :: <real-uniform-distribution>, #key seed = *dylan-random-seed*, #all-keys)
  227.     next-method();
  228.     dist.unit-uniform := make (<unit-uniform-distribution>, seed: seed);
  229. end method;
  230.  
  231.  
  232. // random -- public
  233. //
  234. // Generates real numbers which are distributed uniformly in some
  235. // interval.  Uses the unit uniform generator, and applies the linear
  236. // transformation described above.
  237. //
  238. define method random (dist :: <real-uniform-distribution>)
  239.       => random :: <double-float>;
  240.    (dist.random-to - dist.random-from) * random (dist.unit-uniform) + dist.random-from;
  241. end method;
  242.  
  243.  
  244. // <integer-uniform-distribution> -- public
  245. //
  246. // The concrete class for integer uniform distributions.  Slots for
  247. // the beginning and ending points of the distribution interval.
  248. //
  249. define class <integer-uniform-distribution> (<uniform-distribution>)
  250.    slot unit-uniform :: <unit-uniform-distribution>;
  251.    slot random-from :: <integer>,
  252.       required-init-keyword: from:;
  253.    slot random-to :: <integer>,
  254.       required-init-keyword: to:;
  255. end class;
  256.  
  257.  
  258. // initialize -- interface
  259. //
  260. // The unit uniform distribution used in the uniform has to be set up.
  261. //
  262. define method initialize (dist :: <integer-uniform-distribution>, #key seed = *dylan-random-seed*, #all-keys)
  263.     next-method();
  264.     dist.unit-uniform := make (<unit-uniform-distribution>, seed: seed);
  265. end method;
  266.  
  267.  
  268. // random -- public
  269. //
  270. // Generates integers which are distributed uniformly in some
  271. // interval.  Uses the unit uniform generator, and applies the linear
  272. // transformation described above.
  273. //
  274. // Note: The endpoints of the interval are both inclusive because of
  275. // the rounding.  That is, the numbers generate are in [a, b] instead
  276. // of [a, b).
  277. //
  278.  
  279. define method round (val :: <double-float>) => rval :: <integer>;
  280.     let (rval, fval) = truncate(val);
  281.     if (fval >= 0.5)
  282.         rval + 1;
  283.     else
  284.         rval;
  285.     end if;
  286. end method;
  287.  
  288. define method random (dist :: <integer-uniform-distribution>)
  289.       => random :: <integer>;
  290.    round ((dist.random-to - dist.random-from) * random (dist.unit-uniform)
  291.          + dist.random-from)
  292. end method;
  293.  
  294.  
  295. /* Exponential Distribution
  296.  
  297.    The exponential distribution has a cumulative distribution function
  298.    described by
  299.  
  300.                                    -lx
  301.                F(x) = 1 - e      x > 0
  302.  
  303.    An exponential distribution X can be generated from a unit uniform
  304.    distribution U using a transformation.  That is, a number u from
  305.    the uniform is chosen, then the inverse of the CDF is applied
  306.  
  307.                                     1
  308.                X(u) = - - ln(u)
  309.                                     l
  310.  
  311. */
  312.  
  313. // <exponential-distribution> -- public
  314. //
  315. // The concrete class for exponential distributions.  Slot for the
  316. // lambda parameter of the distribution.
  317. //
  318. define class <exponential-distribution> (<random-distribution>)
  319.    slot unit-uniform :: <unit-uniform-distribution>;
  320.    slot lambda :: <real>,
  321.       init-value: 1,
  322.       init-keyword: lambda:;
  323. end class;
  324.  
  325.  
  326. // initialize -- interface
  327. //
  328. // The unit uniform distribution used in the exponential has to be set
  329. // up.
  330. //
  331. define method initialize (dist :: <exponential-distribution>, #key seed = *dylan-random-seed*, #all-keys)
  332.     next-method();
  333.     dist.unit-uniform := make (<unit-uniform-distribution>, seed: seed);
  334. end method;
  335.  
  336. // random -- public
  337. //
  338. // Generates numbers distributed in an exponential distribution with
  339. // parameter lambda.  Applies the inverse CDF of the exponential
  340. // distribution to a number generated from a unit uniform
  341. // distribution.
  342. //
  343. define method random (dist :: <exponential-distribution>) => random :: <double-float>;
  344.    - (log (random (dist.unit-uniform)) / dist.lambda)
  345. end method;
  346.  
  347.  
  348. /* Normal Distribution
  349.  
  350.    The normal (or Gaussian) probability distribution has a very
  351.    complicated probability density function.  So the methods used to
  352.    generate it are somewhat obscure.  The normal distribution can be
  353.    generated using two uniform distributions, A and B.  Numbers from a
  354.    normal distribution with mean 0 and standard deviation (or sigma) 1
  355.    can be found using this formula:
  356.  
  357.                                   1/2
  358.            X = (- 2 ln(A))    cos(2 pi B).
  359.  
  360.    This distribution can be transformed to a distribution with mean m
  361.    and sigma o by a linear function.
  362.  
  363.                  Y = o X + m
  364.  
  365. */
  366.  
  367. // <normal-distribution> -- public
  368. //
  369. // The concrete class for normal distributions.  Slots for the mean
  370. // and standard deviation (sigma) parameters of the distribution.
  371. //
  372. define class <normal-distribution> (<random-distribution>)
  373.    slot unit-uniform-A :: <unit-uniform-distribution>;
  374.    slot unit-uniform-B :: <unit-uniform-distribution>;
  375.    slot mean :: <real>,
  376.       init-value: 0,
  377.       init-keyword: mean:;
  378.    slot sigma :: <real>,
  379.       init-value: 1,
  380.       init-keyword: sigma:;
  381. end class;
  382.  
  383. // initialize -- interface
  384. //
  385. // Both unit uniform distributions used in the normal have to be set
  386. // up.  The first is seeded from the seed given, and the second is
  387. // seeded from a random number generated by the first.
  388. //
  389. define method initialize (dist :: <normal-distribution>, #key seed = *dylan-random-seed*, #all-keys)
  390.     next-method();
  391.     dist.unit-uniform-A := make (<unit-uniform-distribution>, seed: seed);
  392.     dist.unit-uniform-B := make (<unit-uniform-distribution>, seed: random (dist.unit-uniform-A));
  393. end method;
  394.  
  395.  
  396. // random -- public
  397. // 
  398. // Generates a normal distribution with mean 0 and sigma 1 from two
  399. // numbers chosen from a unit uniform distribution, then applies the
  400. // linear transformation to adjust to the real mean and sigma of the
  401. // desired distribution.
  402. // 
  403. // (The constant $pi$ should be predefined or be defined as 4 *
  404. // atan(1) but we don't have atan.)
  405. //
  406. define constant $pi$ = 3.14159265358975;
  407. //
  408. define method random (dist :: <normal-distribution>) => random :: <double-float>;
  409.    let unit-normal-random = sqrt (-2 * log (random (dist.unit-uniform-A)))
  410.                                * cos (2 * $pi$ * random (dist.unit-uniform-B));
  411.    dist.sigma * unit-normal-random + dist.mean;
  412. end method;
  413.  
  414.  
  415. /* Dylan Global Random Distribution
  416.  
  417.    In addition to the variety of random distributions this library
  418.    provides, we also want to have simpler functions for people to use
  419.    without having to create a distribution.
  420.  
  421.    Global variables hold a default Dylan random seed and distribution.
  422.    The function RANDOM-UNIFORM returns a number in some uniform
  423.    distribution.  The function SEED-RANDOM! allows the user to set the
  424.    global random seed.
  425.  
  426. */
  427.  
  428. // *dylan-random-seed* -- public
  429. // 
  430. // This global variable is used as the default seed for
  431. // <unit-uniform-distribution>s (and thus serves as the default seed
  432. // for most other random distributions.
  433. //
  434. define variable *dylan-random-seed* :: <integer> = 42424242;
  435.  
  436.  
  437. // *dylan-random-distribution* -- public
  438. // 
  439. // This global variable stores the default random distribution that is
  440. // used for the following functions.  This gives the user the
  441. // alternative of not having to create their own distributions.
  442. //
  443. define variable *dylan-random-distribution* = make (<unit-uniform-distribution>, seed: *dylan-random-seed*);
  444.  
  445. // random-uniform -- public
  446. // 
  447. // This function returns a random number from a uniform distribution.
  448. // The bounds of the uniform distribution are given by the keywords
  449. // from: and to:.  The type of the number returned is determined by
  450. // the type of the bounds.  (If the bounds do not have the same type
  451. // an error is signalled.)
  452. // 
  453. // If the bounds are <integer>, the random number is rounded.  If the
  454. // bounds are some other type (such as <single-float>, etc.), the
  455. // random number is coerced to that type.
  456. // 
  457. // This function uses *DYLAN-RANDOM-DISTRIBUTION* to generate the
  458. // random number.
  459. //
  460. define constant random-uniform =
  461.     method (#key from: from-bound = 0.0, to: to-bound = 1.0)
  462.         if (~ object-class (from-bound) == object-class (to-bound))
  463.             error ("Arguments to random-uniform must have same type.");
  464.         end if;
  465.         let random = (to-bound - from-bound)
  466.             * random (*dylan-random-distribution*)
  467.              + from-bound;
  468.         select (object-class (to-bound))
  469.         <integer> =>
  470.             round (random);
  471.         otherwise =>
  472.             as (object-class (to-bound), random);
  473.         end select;
  474.     end method;
  475.  
  476. // seed-random! -- public
  477. //
  478. // This functions seeds the default Dylan distribution.
  479. //
  480. define constant seed-random! =
  481.    method (seed :: <integer>)
  482.       if (seed > 0)
  483.      *dylan-random-seed* := seed;
  484.      *dylan-random-distribution* :=
  485.         make (<unit-uniform-distribution>, seed: *dylan-random-seed*);
  486.       else
  487.      error ("Random seed must be > 0: %d", seed);
  488.       end if;
  489.       *dylan-random-seed*
  490.    end method;
  491.  
  492.  
  493. /* Chi-Square Test for the Random Number Generator
  494.  
  495.    The chi-square function can be used to test the integrity of the
  496.    underlying linear congruential generator.  It takes a
  497.    <integer-uniform-distribution> (which should be a distribution on
  498.    an interval [0, r]) and calculates its chi square value.
  499. */
  500.  
  501. // chi-square -- public
  502. // 
  503. // The chi square value of a integer uniform distribution on [0, r] is
  504. // found by taking the sum of the squares of the difference between
  505. // the frequencies of the elements of the distribution and the mean
  506. // frequency.  The mean frequency is the number of samples divided by
  507. // the number of elements in the interval (N / r).  For this to work,
  508. // N should be at least 10 r.
  509. // 
  510. // This function sets up a frequency array and generates N random
  511. // numbers and fills in their frequencies.  It then calculates the chi
  512. // square value of the distribution.
  513. // 
  514. // The chi square value should be no farther from r than twice the
  515. // square root of r.
  516. //
  517. define method chi-square (dist :: <integer-uniform-distribution>)
  518.    let r = dist.random-to;
  519.    let N = 10 * r;
  520.    let f = as (<double-float>, N) / as (<double-float>, r);
  521.    let freq = make (<vector>, size: r + 1, fill: 0);
  522.    for (i from 0 below N)
  523.       let d = random (dist);
  524.       freq[d] := freq[d] + 1;
  525.    end for;
  526.    for (i from 0 below r,
  527.     sample-sum = 0.0 then sample-sum + (freq[i] - f) ^ 2)
  528.    finally
  529.       sample-sum / f;
  530.    end for;
  531. end method;
  532.